perm filename STUF.FAI[NEW,LCS] blob
sn#561088 filedate 1981-02-05 generic text, type T, neo UTF8
TITLE STUFIT
ENTRY STUFIT, UNSTUF
; THIS PACKS NUMBERS IN BITS AS FOLLOWS:
; 4 / 5 / 3 / 24
; WDCNT/ P1 / P2 / P3
; THEN UNSTUF UNPACKS THEM. (P3 MUST BE IN RANGE, +-9999)
STUFIT: 0 ;CALL STUFIT(VARRAY,N,I)
;N=INPUT PNTR, I=OUTPUT PNTR
SETZM I# ;CALL STUFIT(V,JT)
MOVEI 1
MOVEM N#
S1: MOVEI 1,@(16) ;GET LOC. OF V ARRAY
ADD 1,N ;ADD TO IT N
KIFIX 11,-1(1) ;L=V(N)
MOVE 6,11 ;SAVE L IN AC6
ADDI 11,3 ;NX=L+3+N
ADD 11,N ;NX IS AC11
KIFIX 15,(1) ;J=V(N+1)
MOVE 10,11 ;LX=NX
S9: CAIGE 6,2 ;IF(L.LT.2)GO TO 12
JRST S12
MOVEI 5,@(16) ;IF(V(LX-1).NE.0)GO TO 12
ADD 5,10 ;DROP TRAILING ZERO PARAMS
SKIPE -2(5) ; -AFTER P3-
JRST S12
MOVE [-1.0] ;NOW SET THE WD CNT BACK ONE.
FADRM -1(1) ;V(N)=V(N)-1.
SOJ 10, ;LX=LX-1
SOJA 6,S9 ;L=L-1, GO TO 9
S12: MOVE 6,2(1) ;GET P3
FMPR 6,[1000.00] ;*1000.00
KIFIX 6,6 ;MAKE IT INTEGER
JUMPGE 6,S7 ;IS IT NEGATIVE? - NO, JUMP TO S7
MOVNS 6 ;NOW IT'S POS.
ADD 6,[=10000000] ;+10000000 MEANS IT IS NEG.
S7: LSHC 6,-=24 ;SHIFT IT INTO AC7
KIFIX 6,1(1) ;GET P2 - STAFF
LSHC 6,-3
KIFIX 6,(1) ;GET P1 - CODE
LSHC 6,-5
KIFIX 6,-1(1) ;GET WD CNT
LSHC 6,-4 ;NOW ALL IS STUFFED INTO AC7
MOVEI 1,@(16) ; LOC OF V
ADD 1,I ; PLUS I
MOVEM 7,(1) ; PUT PACKED INFO BACK INTO V ARRAY
MOVEI 1,4
ADDM 1,N ;ADD 4 TO N
AOS I ;ADD 1 TO I
JRST S16 ;********* TEMP. SKIP (AVOID RNDOFF ERRS)
CAIE 15,=16 ;IF(J.EQ.16.OR.J.EQ.8)GOTO16
CAIN 15,8
JRST S16
CAIN 15,=11 ;IF(J.EQ.11)GO TO 16
JRST S16
MOVEI 14,3 ;M=3
S3: CAMN 11,N ;IF(N.EQ.NX)GO TO 2
JRST S2
AOJ 14, ;M=M+1
MOVEI 1,@(16) ;IF(V(N).NE.0)GO TO 4
ADD 1,N
SKIPE 2,-1(1)
JRST S4
S6: AOS N ;N=N+1
JRST S3 ;GO TO 3
S4: AOS I ;I=I+1
MOVE [10000.0] ;X=10000.0
SKIPGE 2 ;IF(V(N).LT.0)X=-X
MOVNS
FLTR 4,14 ;V(I)=V(N)+M*X
FMPR 4,0
FADR 2,4
MOVEI 1,@(16)
ADD 1,I
MOVEM 2,-1(1)
JRST S6 ;GO TO 6
S16: CAMN 10,N ;IF(N.EQ.LX)GO TO 2
;;S16: CAMN 11,N ;IF(N.EQ.NX)GO TO 2
;; JRST S2
JRST S13
MOVE 5,N ;DO 5 K=N,NX-1
S5: AOS I ;I=I+1
MOVEI 1,@(16)
ADD 1,N ;5 V(I)=V(K)
MOVE 6,-1(1)
MOVEI 1,@(16)
ADD 1,I
MOVEM 6,-1(1)
AOS N
;; CAME 11,N
CAME 10,N
JRST S5
S13: MOVEM 11,N
S2: MOVE 6,N
CAMGE 6,@1(16) ;2 IF(N.LT.JT)GO TO 1
JRST S1
MOVE I ;JT=I
MOVEM @1(16)
JRA 16,2(16)
UNSTUF: 0 ;CALL UNSTUF(Q,V,JT)
SETZM I ;I=0
MOVEI 1 ;N=1
MOVEM N
S20: MOVEI 1,@(16) ;GET LOC OF INPUT ARRAY
ADD 1,I ;ADD PNTR I
MOVEI 3,@1(16) ;GET LOC OF V
ADD 3,N ;ADD PNTR N
MOVE 1,(1) ;GET PACKED WORD
LSHC 1,-=24 ;GET P3, SHIFT IT TO AC2
LSH 2,-=12 ;SHIFT IT SOME MORE
CAMG 2,[=10000000] ;IF .GT.10000000 IT WAS NEG.
JRST S70
SUB 2,[=10000000]
MOVNS 2 ;NOW IT'S NEG. AGAIN
S70: FLTR 2,2
FDVR 2,[1000.00]
MOVEM 2,2(3) ;PUT INTO R ARRAY
LSHC 1,-3 ;GET P2
LSH 2,-=33
FLTR 2,2
MOVEM 2,1(3)
LSHC 1,-5
LSH 2,-=31 ;GET P1
FLTR 2,2
MOVEM 2,(3)
LSHC 1,-4 ;GET WD CNT
LSH 2,-=32
FLTR 2,2
MOVEM 2,-1(3) ;ALL DONE
MOVEI 1,4
ADDM 1,N ;ADD 4 TO N
AOS I ;ADD 1 TO I
S200: MOVEI 1,@1(16) ;J=V(N-3)
ADD 1,N
SUBI 1,4
KIFIX 15,(1) ;C GET THE CODE NUM.
KIFIX 11,-1(1) ;NX=V(N-4)-1+N
ADD 11,N ;C HOW FAR DO WE GO FOR THIS ITEM?
SOJ 11,
JRST S36 ;****** TEMPORARY
CAIE 15,=16 ;IF(J.EQ.16)GO TO 36
CAIN 15,=8 ;IF(J.EQ.8)GO TO 36
JRST S36
CAIN 15,=11 ;IF(J.EQ.11)GO TO 36
JRST S36
MOVEI 14,3 ;M=3
S22: CAMN 11,N ;22 IF(N.EQ.NX)GO TO 32
JRST S32
AOJ 14, ;M=M+1
AOS I ;I=I+1
MOVEI 1,@(16) ;L=Q(I)/10000.0
ADD 1,I
MOVE 2,-1(1)
FDVR 2,[10000.0]
KIFIX 13,2 ;AC13 IS L
MOVM 12,13 ;C GET THE PARAM NUM. LL=IABS(L)
S24: CAMN 12,14 ;24 IF(LL.EQ.M)GO TO 21
JRST S21
CAME 11,N ;IF(N.NE.NX)GO TO 25
JRST S25
SOS I ;I=I-1
JRST S32 ;GO TO 32
S25: MOVEI 2,@1(16)
ADD 2,N
SETZM -1(2) ;25 V(N)=0 PUT BACK IN THE ZERO PARAMS.
AOJ 14, ;M=M+1
S23: AOS N ;23 N=N+1
JRST S24 ;GO TO 24
S21: IMULI 13,=10000 ;21 X=Q(I)-L*10000
MOVE 2,[0.001] ;Z=0.001
SKIPGE 13 ;IF(Q(I).LT.0)Z=-Z
MOVNS 2
FLTR 13,13 ;C GET BACK THE REAL CONTENTS OF THE PARAM.
MOVE 1,-1(1) ;Q(I)
FSBR 1,13 ;AC1 IS X
SKIPE 1 ;IF(X.NE.0)X=X+Z FOR ROUNDOFF ERRORS
FADR 1,2
MOVEI 2,@1(16) ;V(N)=X
ADD 2,N
MOVEM 1,-1(2)
AOS N ;N=N+1
JRST S22 ;GO TO 22
S36: CAMN 11,N ;36 IF(N.EQ.NX)GO TO 32
JRST S32
MOVE 5,N ;DO 35 K=N,NX-1
S35: AOS I ; I=I+1
MOVEI 2,@1(16) ;GET LOC OF V ARRAY
MOVEI 1,@(16) ;LOC OF Q ARRAY 35 V(K)=Q(I)
ADD 2,N
ADD 1,I
MOVE 6,-1(1) ;Q(I)
MOVEM 6,-1(2)
AOS N
CAME 11,N
JRST S35 ;N=NX
S32: MOVE I
CAMGE @2(16) ;32 IF(I.LT.JT)GO TO 20
JRST S20
MOVE N ;JT=N
MOVEM @2(16) ;GET NEW WD CNT
JRA 16,3(16)
END